home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-gwp.el.z / efs-gwp.el
Encoding:
Text File  |  1998-05-21  |  5.0 KB  |  159 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-gwp.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.1 $
  7. ;; RCS:          
  8. ;; Description:  Support for efs to use an interactive gateway.
  9. ;; Author:       Andy Norman, Dawn
  10. ;; Created:      Thu Mar 18 13:03:14 1993
  11. ;; Modified:     Sun Nov 27 18:31:50 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. (provide 'efs-gwp)
  20. (require 'efs)
  21.  
  22. ;;;; ------------------------------------------------------------
  23. ;;;; Interactive gateway program support.
  24. ;;;; ------------------------------------------------------------
  25.  
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;;; User Variables and Documentation
  28.  
  29. (defvar efs-gwp-setup-term-command
  30.   (if (eq system-type 'hpux)
  31.       "stty -onlcr -echo\n"
  32.     "stty -echo nl\n")
  33.   "Command to do terminal setup on the gateway machine.
  34. They must stop the terminal echoing each command and strip out trailing 
  35. ^M characters. This string must end in \\n. If you need to send multiple
  36. commands, include them all in this string, separated by \\n.
  37. See the documentation in efs.el for some example commands.")
  38.  
  39. ;; About efs-gwp-term-setup-command:
  40. ;; 
  41. ;; It is important to get efs-gwp-setup-term-command right.
  42. ;; Here are some examples.  Please tell us about which commands
  43. ;; to use on other platforms, so that we can include it in the
  44. ;; documentation.
  45. ;;
  46. ;;
  47. ;; HP-UX:
  48. ;; 
  49. ;;     "stty -onlcr -echo\n"
  50. ;;
  51. ;; SunOS:
  52. ;; 
  53. ;;     "stty -echo nl\n"
  54. ;;
  55. ;; VMS: (this should work)
  56. ;;
  57. ;;     "set terminal/noecho\n"
  58. ;;
  59.  
  60.  
  61. (defvar efs-gwp-prompt-pattern "^[^#$%>;]*[#$%>;] *"
  62.   "*Regexp used to detect that the gateway login sequence has completed.
  63. It will be assumed that the shell is ready to receive input.  Make this
  64. regexp as strict as possible; it shouldn't match *anything* at all except
  65. the shell's initial prompt.  The above string will fail under most SUN-3's
  66. since it matches the login banner.")
  67.  
  68. ;; About efs-gwp-prompt-pattern:
  69. ;;
  70. ;; It is very important that this not match anything in the machine's
  71. ;; login banner.
  72. ;;
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74.  
  75. ;;; Internal Variables
  76.  
  77. (defconst efs-gwp-version
  78.   (concat (substring "$efs release: 1.15 $" 14 -2)
  79.       "/"
  80.       (substring "#Revision: 1.1 $" 11 -2)))
  81.  
  82. (defvar efs-gwp-running t)
  83. (defvar efs-gwp-status nil)
  84. (defvar efs-gwp-string "")
  85.  
  86. ;;; Entry point (defined as an autoload in efs.el)
  87.  
  88. (defun efs-gwp-start (host user name)
  89.   "Login to the gateway machine and fire up an ftp process."
  90.   (message "Connecting to gateway %s..." efs-gateway-host)
  91.   (let ((proc (apply 'start-process name (efs-ftp-process-buffer host user)
  92.              (nth 1 efs-gateway-type)
  93.              (append (nth 2 efs-gateway-type)
  94.                  (list efs-gateway-host))))
  95.     (ftp (concat (nth 3 efs-gateway-type) " "
  96.              (mapconcat (function identity) (nth 4 efs-gateway-type)
  97.                 " ") "\n")))
  98.     (process-kill-without-query proc)
  99.     (set-process-sentinel proc (function efs-gwp-sentinel))
  100.     (set-process-filter proc (function efs-gwp-filter))
  101.     (set-marker (process-mark proc) (point))
  102.     (setq efs-gwp-running t
  103.       efs-gwp-status nil
  104.       efs-gwp-string "")
  105.     (while efs-gwp-running        ;perform login sequence
  106.       (accept-process-output proc))
  107.     (if (not efs-gwp-status)
  108.     (efs-error host user "unable to login to gateway"))
  109.     (message "Connecting to gateway %s...done" efs-gateway-host)
  110.     (setq efs-gwp-running t
  111.       efs-gwp-status nil
  112.       efs-gwp-string "")
  113.     (process-send-string proc efs-gwp-setup-term-command)
  114.     (while efs-gwp-running        ;zap ^M's and double echoing.
  115.       (accept-process-output proc))
  116.     (if (not efs-gwp-status)
  117.     (efs-error host user "unable to set terminal modes on gateway"))
  118.     (setq efs-gwp-running t
  119.       efs-gwp-status nil
  120.       efs-gwp-string "")
  121.     (message "Opening FTP connection to %s..." host)
  122.     (process-send-string proc ftp)
  123.     proc))
  124.  
  125. ;;; Process filter/sentinel
  126.  
  127. (defun efs-gwp-sentinel (proc str)
  128.   (setq efs-gwp-running nil))
  129.  
  130. (defun efs-gwp-filter (proc str)
  131.   (efs-save-match-data
  132.     ;; Don't be sensitive to login vn LOGIN.
  133.     (let ((case-fold-search t))
  134.       (efs-process-log-string proc str)
  135.       (setq efs-gwp-string (concat efs-gwp-string str))
  136.       (cond ((string-match "\\(login\\|username\\): *$" efs-gwp-string)
  137.          (process-send-string proc
  138.                   (concat
  139.                    (let ((efs-default-user t))
  140.                      (efs-get-user efs-gateway-host))
  141.                    "\n")))
  142.         ((string-match "password: *$" efs-gwp-string)
  143.          (process-send-string proc
  144.                   (concat
  145.                    (efs-get-passwd efs-gateway-host
  146.                            (efs-get-user
  147.                             efs-gateway-host))
  148.                    "\n")))
  149.         ((string-match efs-gateway-fatal-msgs
  150.                efs-gwp-string)
  151.          (delete-process proc)
  152.          (setq efs-gwp-running nil))
  153.         ((string-match efs-gwp-prompt-pattern
  154.                efs-gwp-string)
  155.          (setq efs-gwp-running nil
  156.            efs-gwp-status t))))))
  157.  
  158. ;;; end of efs-gwp.el
  159.